home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / HiLoGrid.cls < prev    next >
Text File  |  1999-06-22  |  11KB  |  387 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "HiLoGrid3d"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private Xmin As Single      ' Min X and Y values.
  17. Private Zmin As Single
  18. Private Dx As Single        ' Spacing between rows of data.
  19. Private Dz As Single
  20. Private NumX As Integer     ' Number of X and Y entries.
  21. Private NumZ As Integer
  22. Private Points() As Point3D ' Data values.
  23.  
  24. Public RemoveHidden As Boolean
  25. ' Draw a line between the points. Set the hi and
  26. ' lo values for the line.
  27. Private Sub DrawAndSetLine(ByVal pic As PictureBox, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, hi() As Integer, lo() As Integer)
  28. Dim tmp As Single
  29. Dim ix As Integer
  30. Dim iy As Integer
  31. Dim Y As Single
  32. Dim dy As Single
  33.  
  34.     ' Deal only with integers.
  35.     x1 = CInt(x1)
  36.     y1 = CInt(y1)
  37.     x2 = CInt(x2)
  38.     y2 = CInt(y2)
  39.  
  40.     ' Make x1 < x2.
  41.     If x2 < x1 Then
  42.         tmp = x1
  43.         x1 = x2
  44.         x2 = tmp
  45.         tmp = y1
  46.         y1 = y2
  47.         y2 = tmp
  48.     End If
  49.  
  50.     ' Draw the line.
  51.     pic.Line (x1, y1)-(x2, y2)
  52.  
  53.     ' Deal with vertical lines separately.
  54.     If x1 = x2 Then
  55.         If y1 < y2 Then
  56.             lo(x1) = y1
  57.             hi(x1) = y2
  58.         Else
  59.             lo(x1) = y2
  60.             hi(x1) = y1
  61.         End If
  62.         Exit Sub
  63.     End If
  64.  
  65.     ' Deal with non-vertical lines.
  66.     dy = (y2 - y1) / CInt(x2 - x1)
  67.     Y = y1
  68.     For ix = x1 To x2
  69.         iy = CInt(Y)
  70.  
  71.         lo(ix) = iy
  72.         hi(ix) = iy
  73.  
  74.         Y = Y + dy
  75.     Next ix
  76. End Sub
  77. ' Draw a line between the points using and
  78. ' updating the hi and lo arrays.
  79. Private Sub DrawLine(ByVal pic As PictureBox, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, hi() As Integer, lo() As Integer)
  80. Dim tmp As Single
  81. Dim ix As Integer
  82. Dim iy As Integer
  83. Dim Y As Single
  84. Dim dy As Single
  85. Dim firstx As Integer
  86. Dim firsty As Integer
  87. Dim skipping As Boolean
  88. Dim above As Boolean
  89.  
  90.     ' Deal only with integers.
  91.     x1 = CInt(x1)
  92.     y1 = CInt(y1)
  93.     x2 = CInt(x2)
  94.     y2 = CInt(y2)
  95.  
  96.     ' Make x1 < x2.
  97.     If x2 < x1 Then
  98.         tmp = x1
  99.         x1 = x2
  100.         x2 = tmp
  101.         tmp = y1
  102.         y1 = y2
  103.         y2 = tmp
  104.     End If
  105.  
  106.     ' Deal with vertical lines separately.
  107.     If x1 = x2 Then
  108.         ' Make y1 < y2.
  109.         If y2 < y1 Then
  110.             tmp = y1
  111.             y1 = y2
  112.             y2 = tmp
  113.         End If
  114.         If y1 <= lo(x1) Then
  115.             If y2 <= lo(x1) Then
  116.                 pic.Line (x1, y1)-(x2, y2)
  117.             Else
  118.                 pic.Line (x1, y1)-(x2, lo(x2))
  119.             End If
  120.             lo(x1) = y1
  121.         End If
  122.         If y2 >= hi(x2) Then
  123.             If y1 >= hi(x2) Then
  124.                 pic.Line (x1, y1)-(x2, y2)
  125.             Else
  126.                 pic.Line (x1, hi(x1))-(x2, y2)
  127.             End If
  128.             hi(x2) = y2
  129.         End If
  130.         Exit Sub
  131.     End If
  132.  
  133.     ' Deal with non-vertical lines.
  134.     dy = (y2 - y1) / CInt(x2 - x1)
  135.     Y = y1
  136.  
  137.     ' Find the first visible point.
  138.     skipping = True
  139.     For ix = x1 To x2
  140.         iy = CInt(Y)
  141.         ' See if this point is visible.
  142.         If iy <= lo(ix) Then
  143.             If skipping Then
  144.                 ' Start a new line below.
  145.                 skipping = False
  146.                 above = False
  147.                 firstx = ix
  148.                 firsty = lo(ix)
  149.             End If
  150.         ElseIf iy >= hi(ix) Then
  151.             If skipping Then
  152.                 ' Start a new line above.
  153.                 skipping = False
  154.                 above = True
  155.                 firstx = ix
  156.                 firsty = hi(ix)
  157.             End If
  158.         Else
  159.             ' This point is not visible.
  160.             If Not skipping Then
  161.                 ' Draw the previous visible line.
  162.                 If above Then
  163.                     ' The line is coming from
  164.                     ' above. Connect it to hi(ix).
  165.                     pic.Line (firstx, firsty)-(ix, hi(ix))
  166.                 Else
  167.                     ' The line is coming from
  168.                     ' below. Connect it to lo(ix).
  169.                     pic.Line (firstx, firsty)-(ix, lo(ix))
  170.                 End If
  171.                 
  172.                 skipping = True
  173.             End If
  174.         End If
  175.  
  176.         If iy < lo(ix) Then lo(ix) = iy
  177.         If iy > hi(ix) Then hi(ix) = iy
  178.  
  179.         Y = Y + dy
  180.     Next ix
  181.  
  182.     ' Draw to the last point if necessary.
  183.     If Not skipping Then _
  184.         pic.Line (firstx, firsty)-(x2, y2)
  185. End Sub
  186. ' Draw the grid including hidden surfaces.
  187. Public Sub DrawWithHidden(ByVal pic As PictureBox, Optional R As Variant)
  188. Dim i As Integer
  189. Dim j As Integer
  190.  
  191.     On Error Resume Next
  192.         
  193.     ' Draw lines parallel to the X axis.
  194.     For i = 1 To NumX
  195.         pic.CurrentX = Points(i, 1).trans(1)
  196.         pic.CurrentY = Points(i, 1).trans(2)
  197.         For j = 2 To NumZ
  198.             pic.Line -(Points(i, j).trans(1), _
  199.                           Points(i, j).trans(2))
  200.         Next j
  201.     Next i
  202.  
  203.     ' Draw lines parallel to the Y axis.
  204.     For j = 1 To NumZ
  205.         pic.CurrentX = Points(1, j).trans(1)
  206.         pic.CurrentY = Points(1, j).trans(2)
  207.         For i = 2 To NumX
  208.             pic.Line -(Points(i, j).trans(1), _
  209.                           Points(i, j).trans(2))
  210.         Next i
  211.     Next j
  212. End Sub
  213. ' Draw the grid without hidden surfaces using the
  214. ' Hi-Lo algorithm.
  215. Public Sub DrawWithoutHidden(ByVal pic As Object, Optional R As Variant)
  216. Dim Xmin As Integer
  217. Dim Xmax As Integer
  218. Dim lo() As Integer
  219. Dim hi() As Integer
  220. Dim ix As Integer
  221. Dim i As Integer
  222. Dim j As Integer
  223.  
  224.     ' Bound the X values.
  225.     Xmin = Points(1, 1).trans(1)
  226.     Xmax = Xmin
  227.     For i = 1 To NumX
  228.         For j = 1 To NumZ
  229.             ix = CInt(Points(i, j).trans(1))
  230.             If Xmin > ix Then Xmin = ix
  231.             If Xmax < ix Then Xmax = ix
  232.         Next j
  233.     Next i
  234.  
  235.     ' Create the hi and lo arrays.
  236.     ReDim lo(Xmin To Xmax)
  237.     ReDim hi(Xmin To Xmax)
  238.  
  239.     ' Draw the X and Z front edges.
  240.     For i = 2 To NumX
  241.         ' Draw the edge between
  242.         ' Points(i - 1, NumZ) and Points(i, NumZ)
  243.         ' and set hi and lo for its values.
  244.         DrawAndSetLine pic, _
  245.             Points(i - 1, NumZ).trans(1), _
  246.             Points(i - 1, NumZ).trans(2), _
  247.             Points(i, NumZ).trans(1), _
  248.             Points(i, NumZ).trans(2), _
  249.             hi, lo
  250.     Next i
  251.     For i = 2 To NumZ
  252.         ' Draw the edge between
  253.         ' Points(NumX, i - 1) and Points(NumX, i)
  254.         ' and set hi and lo for its values.
  255.         DrawAndSetLine pic, _
  256.             Points(NumX, i - 1).trans(1), _
  257.             Points(NumX, i - 1).trans(2), _
  258.             Points(NumX, i).trans(1), _
  259.             Points(NumX, i).trans(2), _
  260.             hi, lo
  261.     Next i
  262.  
  263.     ' Draw the "rectangles."
  264.     For i = NumX - 1 To 1 Step -1
  265.         For j = NumZ - 1 To 1 Step -1
  266.             ' Draw the edges between:
  267.             '   Points(i, j) and Points(i + 1, j)
  268.             '   Points(i, j) and Points(i, j + 1)
  269.             
  270.             ' If the right side of the "rectangle"
  271.             ' leans over the top like this:
  272.             '    +_
  273.             '    | \_
  274.             '    |   \_
  275.             '    +     \_
  276.             '     \      \
  277.             '      +------+
  278.             ' draw the top first so the right side
  279.             ' doesn't make hi() too bit and stop
  280.             ' the top from being drawn.
  281.             '
  282.             ' This only happens with perspective
  283.             ' projection.
  284.             If Points(i + 1, j).trans(1) >= Points(i, j).trans(1) Then
  285.                 DrawLine pic, _
  286.                     Points(i, j).trans(1), _
  287.                     Points(i, j).trans(2), _
  288.                     Points(i, j + 1).trans(1), _
  289.                     Points(i, j + 1).trans(2), _
  290.                     hi, lo
  291.                 DrawLine pic, _
  292.                     Points(i, j).trans(1), _
  293.                     Points(i, j).trans(2), _
  294.                     Points(i + 1, j).trans(1), _
  295.                     Points(i + 1, j).trans(2), _
  296.                     hi, lo
  297.             Else
  298.                 DrawLine pic, _
  299.                     Points(i, j).trans(1), _
  300.                     Points(i, j).trans(2), _
  301.                     Points(i + 1, j).trans(1), _
  302.                     Points(i + 1, j).trans(2), _
  303.                     hi, lo
  304.                 DrawLine pic, _
  305.                     Points(i, j).trans(1), _
  306.                     Points(i, j).trans(2), _
  307.                     Points(i, j + 1).trans(1), _
  308.                     Points(i, j + 1).trans(2), _
  309.                     hi, lo
  310.             End If
  311.         Next j
  312.     Next i
  313. End Sub
  314. ' Create the Points array.
  315. Public Sub SetBounds(ByVal x1 As Single, ByVal deltax As Single, ByVal xnum As Integer, ByVal z1 As Single, ByVal deltaz As Single, ByVal znum As Integer)
  316. Dim i As Integer
  317. Dim j As Integer
  318. Dim X As Single
  319. Dim Z As Single
  320.  
  321.     Xmin = x1
  322.     Zmin = z1
  323.     Dx = deltax
  324.     Dz = deltaz
  325.     NumX = xnum
  326.     NumZ = znum
  327.     ReDim Points(1 To NumX, 1 To NumZ)
  328.     
  329.     X = Xmin
  330.     For i = 1 To NumX
  331.         Z = Zmin
  332.         For j = 1 To NumZ
  333.             Points(i, j).coord(1) = X
  334.             Points(i, j).coord(2) = 0
  335.             Points(i, j).coord(3) = Z
  336.             Points(i, j).coord(4) = 1#
  337.             Z = Z + Dz
  338.         Next j
  339.         X = X + Dx
  340.     Next i
  341. End Sub
  342. ' Save the indicated data value.
  343. Public Sub SetValue(ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
  344. Dim i As Integer
  345. Dim j As Integer
  346.  
  347.     i = (X - Xmin) / Dx + 1
  348.     j = (Z - Zmin) / Dz + 1
  349.     Points(i, j).coord(2) = Y
  350. End Sub
  351.  
  352. ' Apply a transformation matrix which may not
  353. ' contain 0, 0, 0, 1 in the last column to the
  354. ' object.
  355. Public Sub ApplyFull(M() As Single)
  356. Dim i As Integer
  357. Dim j As Integer
  358.  
  359.     For i = 1 To NumX
  360.         For j = 1 To NumZ
  361.             m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
  362.         Next j
  363.     Next i
  364. End Sub
  365.  
  366. ' Apply a transformation matrix to the object.
  367. Public Sub Apply(M() As Single)
  368. Dim i As Integer
  369. Dim j As Integer
  370.  
  371.     For i = 1 To NumX
  372.         For j = 1 To NumZ
  373.             m3Apply Points(i, j).coord, M, Points(i, j).trans
  374.         Next j
  375.     Next i
  376. End Sub
  377.  
  378.  
  379. ' Draw the transformed points on a PictureBox.
  380. Public Sub Draw(ByVal pic As PictureBox)
  381.     If RemoveHidden Then
  382.         DrawWithoutHidden pic
  383.     Else
  384.         DrawWithHidden pic
  385.     End If
  386. End Sub
  387.